perm filename MSFAI.FAI[NEW,LCS] blob sn#592287 filedate 1981-06-09 generic text, type T, neo UTF8
;*** SUBROUTINES FROM MS.F4
;*** DISAPR, INSCOR, ZOOM, ESPOS

	TITLE MSFAI
	INTERNAL DISAPR,INSCOR,ZOOM,EDCEN
	EXTERNAL .COMM.,LIMIT,XRN,DL,RRJJ,DPY,PTR,CHK,SCM,RMOD,SIZ
	EXTERNAL STF,POSI,ALF,A2Z,DPTR,YED,JCLIP,JCHAR,FONT,ZCRSOR,AMOD
	EXTERNAL DPYDO,ACCPOG,SCMSS,SHRINK,SCMSS,HOMX,SCL,HYDPOG
;	INTEGER FUNCTION DISAPR(DP);	DIMENSION DP(0/7)
;	COMMON R2,JA,CENTR,J2,RJQ(20)
DISAPR:	0	;	DISAPR=0
	SETZ	;	IF(R2.GT.7)GO TO 620
	MOVE 2,(16)	;GET LOC OF DP ARRAY
;  GO BACK AND RESET ALL IF STF NUM >7
	KIFIX 1,.COMM.	;K=R2
	CAILE 1,7    	;JA=0
	JRST DIS620
	SETZ 3,  ;JA   	;IF(K.GE.0)GO TO 610
	JUMPGE 1,DIS610
	MOVEI 1,7	;C TYPE DP -1  FOR ALL INVISIBLE
DIS611:	SETOM (2)	;DO 611 K=0,7
	AOJ 2,
	SOJGE 1,DIS611	;611	DP(K)=-1
DIS1:	JRA 16,1(16)	;RETURN
DIS610:	CAILE 1,=8	;IF(K.GT.8)GO TO 1320
	JRST DS1320	;C END WITH ANY NUMBER >8 TO CAUSE NEW DPY
	CAIN 1,=8	;610	IF(K.EQ.8)K=0
	SETZ 1,
	ADD 1,(16)	;GET LOC OF DP ARRAY
	MOVNS (1)	;DP(K)=-DP(K)
	AOJ 3,      	;JA=JA+1
	KIFIX 1,.COMM.+3(3)	;K=RJQ(JA)
	JUMPE 1,DIS1	;IF(K.EQ.0)RETURN
;;	CAIN 1,=99	;C  JUMP OUT IF RJQ(JA)=0 OR 99
;;	JRST DS1320	;IF(K.EQ.99)GO TO 1320
;*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
	JRST DIS610	;GO TO 610
DIS620:	MOVEI 1,7
	MOVEI 0,1
DIS630:	MOVEM 0,(2)	;620	DO 630 K=0,7
	AOJ 2,		;630	DP(K)=1
	SOJGE 1,DIS630
DS1320:	SETOM		;1320	DISAPR=-1
	JRA 16,1(16)	;C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.

;	FUNCTION INSCOR(SCORE)
;	IMPLICIT INTEGER(A-Q,S-Z)
;	COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
;	COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
;	1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO 
;	1 /PTR/PWDS(350) /CHK/ICHK,ITCHK,JIT,SPD,IDPY,M
;	3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
;	2 /RMOD/RMODE2,RSET4,IBEAM
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
;	EQUIVALENCE (ST2,ST(2))
INSCOR:	0     		;	INSCOR=0
	SKIPGE SCM+=281		;	IF(REND.LT.0)GO TO 1050
	JRST IN1050		;C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
	JSA 16,SCMSS		;CALL SCMSS
	SETZM DL+4		;IOLD=0
	MOVE 1,SCM+=281		;	IF(REND.EQ.1)GO TO 1050
	CAMN 1,[1.0]		;	IF(REND.NE.99)GO TO 1020
	JRST IN1050
	CAME 1,[99.0]
	JRST IN1020
	MOVE CHK		;I=ICHK
	MOVEM LIMIT+3
	MOVE CHK+1		;ITEM=ITCHK
	MOVEM LIMIT+1
	MOVE CHK+4		;ST2=IDPY
	MOVEM DPY+1
	JSA 16,ACCPOG		;CALL ACCPOG(1)
	JUMP [1]
        JSA 16,DPYDO		;CALL DPYDO(1)
	JUMP [1]
	JRST IN1050		;GO TO 1050
IN1020:	MOVE CHK+2		;1020	ITEM=JIT
	MOVEM LIMIT+1
	MOVE 1,CHK+5		;J=M
IN1030:	AOS LIMIT+1		;1030	ITEM=ITEM+1
	MOVE 2,LIMIT+1		;PWDS(ITEM)=J
	MOVEM 1,PTR-1(2)
	KIFIX 3,XRN-1(1)
	ADDI 3,3
	ADD 1,3			;J=J+RN(J)+3
	CAMGE 1,LIMIT+3		;IF(J.LT.I)GO TO 1030
	JRST IN1030
	SKIPGE RMOD+2		;IF(IBEAM)GO TO 1040
	JRST IN1040
	MOVE SCM+=80		;R2=RSTF
	MOVEM .COMM.
	SETOM .COMM.+1		;JA=-1
	JSA 16,HOMX		;CALL HOMX
				;C GO ADJUST STEM LENGTHS
IN1040:	MOVE CHK+2		;1040	ITEM=JIT
	MOVEM LIMIT+1
	MOVE CHK+3		;ST2=SPD
	MOVEM DPY+1
	SETZ		;(INSCOR=0)
	JRA 16,1(16)		;RETURN
IN1050:	SETOM @(16)
	JSA 16,SHRINK		;1050	SCORE=-1
	JUMP CHK+2		;CALL SHRINK(JIT)
			;  GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
	SETOM DPY+=4001		;IGO=-1
	MOVEI =16		;JA=16
	MOVEM .COMM.+1		;C  FOR TRAP AT 'EDIT'
	SETO			;INSCOR=-1
	JRA 16,1(16)

RZMSZ:	[1.0]  ;	DATA RZMSZ/1.0/,RZMX/50.0/,RZMY/50.0/
RZMX:	[50.0];DATA STATEMENT NEEDED TO GET CORRECT NUMS. FOR ZU,ZD, ETC. BEFORE Z1, ETC.
RZMY:	[50.0]
RZZZ:	0
ZOOM:	0		;	SUBROUTINE ZOOM
;C** CALLS SCL, ZCRSOR
;	IMPLICIT INTEGER(A-Q,S-Z)
;	REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
;	COMMON /SIZ/RSZ,JCEN,KCEN
;	COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
;	1 /STF/RSTFAC(0/7),RSTJ2 /FONT/JFONT
;	2  /POSI/STFF(0/7),JJ2,POS  /ALF/INP(72),ML 
;	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
;	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
;	1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO  /DPTR/WDS(350)
;	2 /YED/YED,IBOX,RBOX/JCLIP/JCLIP
;	EQUIVALENCE (R5,RJQ(3)),(R4,RJQ(2))
;	2 ,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1))
; 'Z' = ZOOM   CAN'T DO ZOOM WHILE IN EDIT MODE
	MOVE 1,ALF+1	;IF(I2.NE.LDD.AND.I2.NE.LUU)CALL HYDPOG(2)
	CAME 1,A2Z+3	;C CLEAR SPACING SCALE IF NOT MOVING UP OR DOWN.
	CAMN 1,A2Z+=20
	JRST ZM1
	JSA 16,HYDPOG
	JUMP [2]
ZM1:	MOVEI =24	;	JA=24
	MOVEM .COMM.+1
	SETZM DPY+=4001		;IGO=0
ZM1180:	MOVE 2,.COMM.		;1180	IF(R2.LT.200)GO TO 1190
	CAMGE 2,[200.0]
	JRST ZM1190
	JSA 16,AMOD		;R3=AMOD(R2,100.)
	JUMP .COMM.
	JUMP [100.0]
	MOVEM .COMM.+4
	FSBR 0,.COMM.		;R2=(R2-R3)/100.
	FDVR 0,[100.0]
	MOVNM 0,.COMM.
	MOVE 2,[9.0]		;R4=5*IFIX(9.0/R2)
	FDVR 2,.COMM.  ;C Z240 GIVES 2 40 20. Z366 GIVES 3 66 15.  Z490 GIVES 4 90 10.
	KIFIX 2,2
	IMULI 2,5
	FLTR 2,2
	MOVEM 2,.COMM.+5
ZM1190:	MOVE 2,.COMM.+4		;1190	IF(R2.GT.1.OR.R3+R4.NE.0)GO TO 1195
	FADR 2,.COMM.+5
	JUMPN 2,ZM1195
	MOVE 2,.COMM.
	CAMLE 2,[1.0]
	JRST ZM1195
	MOVE [50.0]		;R3=50.0
	MOVEM .COMM.+4
	MOVEM .COMM.+5		;R4=50.0
ZM1195:	SKIPLE 4,ALF+1	;Z1 ONLY ADDS IN 50,50   SO WE CAN ZOOM UP AND DOWN AT ANY SIZE.
	JRST ZM1250		;1195	IF(I2.GT.0)GO TO 1250
	MOVE 1,.COMM.  ;NEXT SECTION FOR ZLn, ZRn, ZUn, ZDn. n=% OF SCREEN CHANGE OF CENTER PO
	MOVEM 1,.COMM.+4	;R3=R2
	JUMPN 1,ZM2		;CRR*** ABOVE REPLACES REREAD
	MOVE RZZZ		;IF(R3.EQ.0)R3=RZZZ
	MOVEM .COMM.+4
ZM2:	MOVE .COMM.+4		;RZZZ=R3
	MOVEM RZZZ		;C SAVE R3 FOR REPEAT OF COMMAND WITHOUT n.
	FDVR RZMSZ		;R3=R3/RZMSZ
	MOVEM .COMM.+4  ;'ZR10' MEANS MOVE CENTER OF IMAGE 10% OF SCREEN SIZE TO RIGHT.
	CAME 4,A2Z+=17		;IF(I2.NE.LRR)GO TO 1220
	JRST ZM1220
	MOVNS .COMM.+4		;R3=-R3
ZM1200:	MOVE RZMX		;1200	R3=RZMX+R3
	FADRM .COMM.+4
	MOVE RZMY		;R4=RZMY
	MOVEM .COMM.+5
ZM1210:	MOVE RZMSZ		;1210	R2=RZMSZ
	MOVEM .COMM.
	JRST ZM1290		;GO TO 1290
ZM1220:	CAMN 4,A2Z+=11		;1220	IF(I2.EQ.LEL)GO TO 1200
	JRST ZM1200
	CAME 4,A2Z+=20		;IF(I2.NE.LUU)GO TO 1240
	JRST ZM1240
	MOVNS .COMM.+4		;R3=-R3
ZM1230:	MOVE .COMM.+4		;1230	R4=RZMY+R3
	FADR RZMY
	MOVEM .COMM.+5
	MOVE RZMX		;R3=RZMX
	MOVEM .COMM.+4
	SETZM ALF		;I1=0
	JRST ZM1210    ;C I1=0 STOPS REDRAWING OF SPACING SCALE FOR UP-DOWN ZOOMS
;;ZM1240:	MOVE ALF+1		;	GO TO 1210
ZM1240:	CAMN 4,A2Z+3		;1240	IF(I2.EQ.LDD)GO TO 1230
	JRST ZM1230		;1250	JCLIP=525
ZM1250:	MOVEI =525		;C SETS CLIP LIMITS IN CLIP SUBR.
	MOVEM JCLIP
	SKIPE .COMM.		;IF(R2.NE.0)GO TO 1270
	JRST ZM1270
	CAMN 4,A2Z+=25		;IF(I2.EQ.LZZ)GO TO 1280
	JRST ZM1280
	SETOM DPY+=4001		;IGO=-1
ZM1260:	MOVE [1.0]		;1260	R2=1.
	MOVEM .COMM.	;C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
ZM1270:	MOVE .COMM.		;1270	IF(R2.LE.1)GO TO 1290
	CAMG [1.0]
	JRST ZM1290
	MOVEI =511		;JCLIP=511
	MOVEM JCLIP
	SKIPE .COMM.+4		;IF(R3.NE.0)GO TO 1290
	JRST ZM1290
ZM1280:	JSA 16,ZCRSOR		;1280	CALL ZCRSOR
ZM1290:	MOVE 1,.COMM.  ;'Zn' (AND NO OTHER NUM) WHERE n >1 ALLOWS YOU SET CENTER WITH LIGHTPEN
	FMPR 1,[0.845]		;1290	RSZ=.845*R2
	MOVEM 1,SIZ
	MOVE .COMM.		;	RZMSZ=R2
	MOVEM RZMSZ
	MOVE 3,.COMM.+4		;RZMX=R3
	MOVEM 3,RZMX
	MOVE 4,.COMM.+5		;	RZMY=R4
	MOVEM 4,RZMY		;C REMEMBER FACTORS
	FMPR 3,[10.0]		;JCEN=(R3*10-500)*RSZ
	FSBR 3,[500.0]
	FMPR 3,SIZ
	KIFIX 3,3
	MOVEM 3,SIZ+1
	FMPR 4,[10.0]		;KCEN=(R4*10-480)*RSZ
	FSBR 4,[480.0]
	FMPR 4,SIZ
	KIFIX 4,4
	MOVEM 4,SIZ+2
;ZM1300:	MOVE 2,.COMM.+5		;C  NEXT TO RECONSTITUTE SPACING SCALE.
;	FSBR 2,[100.0]		;1300	R2=(R4-100.)/100.
;	FDVR 2,[100.0]		;C%%%%%%%%%%%%%
;	SKIPGE 2		;IF(R2.LT.0)R2=0
;	SETZ 2,			;C  WE DON'T WORRY IF IT'S TOO HIGH (YET).
;	MOVEM 2,.COMM.
ZM1310:	SETZM .COMM.+5		;1310	R4=0
	SETZM .COMM.		;R2=0
	MOVE RZMSZ		;IF(RZMSZ.LE.1)GO TO 1315
	CAMG [1.0]	;C PUT UP SPACING SCALE ABOVE STAFF 1 FOR ZOOMS .GT.1
	JRST ZM1315		;R2=1
	MOVE [1.0]
	MOVEM .COMM.
	SKIPE ALF		;IF(I1.NE.0)CALL SCL
	JSA 16,SCL
	SETZM .COMM.		;	R2=0
ZM1315:	SETZM .COMM.+4		;1315	R3=0
	SETZM .COMM.+5		;R4=0
; IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
	SETZM FONT		;JFONT=0
	JRA 16,(16)


;	SUBROUTINE EDCEN(ICB)
;	COMMON R2,JA /ALF/I1,I2,I3
;	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
;	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
EDCEN:	0		;	R2=1.
	MOVE 3,@(16) ;CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
	MOVEI =13		;JA=13
	MOVEM .COMM.+1
	MOVE 2,[1.0]		;IF(I2.EQ.LXX)R2=0
	MOVE 1,ALF+1
	CAMN 1,A2Z+=23
	SETZ 2,
	CAMN 1,A2Z+7		;IF(I2.EQ.LHH)R2=-R2
	MOVNS 2
	CAMN 1,A2Z+=19		;IF(I2.EQ.LTT)R2=-2.
	MOVN 2,[2.0]
	CAMN 1,A2Z+1		;IF(I2.EQ.LBB)ICB=6
	MOVEI 3,6
	CAME 1,A2Z+=21		;IF(I2.EQ.LVV.OR.I2.EQ.LDD)ICB=-1
	CAMN 1,A2Z+3
	SETO 3,
	MOVE ALF+2		;IF(I3.EQ.LVV)ICB=ICB-10
	CAMN A2Z+=21  ;TYPE 'CB' FOR CENTER-BIG  (BIG RANGE =6) ***** 'CV'=SET CURVE OF SLUR
	SUBI 3,=10  ;CBV, CHV, CTV WILL SET CURVE AND DO CENTERING.  CD CENTERS DASH BETWEEN WDS.
	MOVEM 3,@(16)
	MOVEM 2,.COMM.
	JRA 16,1(16)
	END